home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PMRUN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  7.0 KB  |  246 lines
  1. { pmrun.pas -- Run the Program Manager via DDE link }
  2.  
  3. program PMRun;
  4.  
  5. {$R pmrun.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, Strings, StdDlgs;
  8.  
  9. const
  10.  
  11.   id_Menu         = 100;    { Menu resource ID }
  12.   cm_CreateGroup  = 101;    { Create group command ID }
  13.   cm_AddItem      = 102;    { Add item command ID }
  14.   cm_ShowGroup    = 103;    { Show group command ID }
  15.   cm_ExitWindows  = 104;    { Exit Windows command ID }
  16.   cm_Quit         = 105;    { Exit program command ID }
  17.   maxBufLen       = 80;     { Maximum size of a command string }
  18.  
  19.   serverName = 'PROGMAN';   { Program manager DDE server name }
  20.   serverTopic = serverName; { Topic is the same as the app name }
  21.  
  22. type
  23.  
  24.   PMRunApplication = object(TApplication)
  25.     procedure InitMainWindow; virtual;
  26.   end;
  27.  
  28.   PPMRunWindow = ^PMRunWindow;
  29.   PMRunWindow = object(TWindow)
  30.     LinkEstablished: Boolean;  { True if conversation established }
  31.     HWndPM: HWnd;              { Handle to PM window }
  32.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  33.     function CanClose: Boolean; virtual;
  34.     function GetCommand(Prompt, Buffer: PChar): Boolean;
  35.     function Linked: Boolean;
  36.     procedure SendPMCommand(P: PChar);
  37.     procedure Execute(Prompt, Command: PChar);
  38.     procedure WMDDEAck(var Msg: TMessage);
  39.       virtual wm_First + wm_DDE_Ack;
  40.     procedure WMDDETerminate(var Msg: TMessage);
  41.       virtual wm_First + wm_DDE_Terminate;
  42.     procedure CMCreateGroup(var Msg: TMessage);
  43.       virtual cm_First + cm_CreateGroup;
  44.     procedure CMAddItem(var Msg: TMessage);
  45.       virtual cm_First + cm_AddItem;
  46.     procedure CMShowGroup(var Msg: TMessage);
  47.       virtual cm_First + cm_ShowGroup;
  48.     procedure CMExitWindows(var Msg: TMessage);
  49.       virtual cm_First + cm_ExitWindows;
  50.     procedure CMQuit(var Msg: TMessage);
  51.       virtual cm_First + cm_Quit;
  52.   end;
  53.  
  54.  
  55. { PMRunApplication }
  56.  
  57. {- Initialize PMRunApplication object's window }
  58. procedure PMRunApplication.InitMainWindow;
  59. begin
  60.   MainWindow := New(PPMRunWindow, Init(nil, 'PMRun'))
  61. end;
  62.  
  63.  
  64. { PMRunWindow }
  65.  
  66. {- Construct PMRunWindow object }
  67. constructor PMRunWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  68. begin
  69.   TWindow.Init(AParent, ATitle);
  70.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  71.   LinkEstablished := false
  72. end;
  73.  
  74. {- Unlink from PM and return true if application can end }
  75. function PMRunWindow.CanClose: Boolean;
  76. begin
  77.   if LinkEstablished and IsWindow(HWndPM) then
  78.     PostMessage(HWndPM, wm_DDE_Terminate, HWindow, 0);
  79.   CanClose := true
  80. end;
  81.  
  82. {- Prompt for cmd. Return Buffer and true or false to cancel }
  83. function PMRunWindow.GetCommand(Prompt, Buffer: PChar): Boolean;
  84. begin
  85.   Buffer[0] := #0;   { Erase buffer }
  86.   GetCommand :=
  87.   (Application^.ExecDialog(New(PInputDialog,
  88.     Init(@Self, 'Program Manager Command', Prompt,
  89.     Buffer, maxBufLen + 1))) = id_Ok) and (StrLen(Buffer) > 0)
  90. end;
  91.  
  92. {- Respond to wm_DDE_Ack message from server }
  93. procedure PMRunWindow.WMDDEAck(var Msg: TMessage);
  94. var
  95.   AppAtom, AppTopic: TAtom;  { Atoms for wm_DDE_Initiate }
  96.   HMem: THandle;             { Memory handle for wm_DDE_Execute }
  97.   DDEStatus: Word;           { Execution status }
  98. begin
  99.   if not LinkEstablished then
  100.   begin
  101.     LinkEstablished := true;
  102.     AppTopic := HiWord(Msg.LParam);
  103.     AppAtom := LoWord(Msg.LParam);
  104.     HWndPM := Msg.WParam;  { Save server's window handle }
  105.     if AppAtom <> 0 then
  106.       GlobalDeleteAtom(AppAtom);
  107.     if AppTopic <> 0 then
  108.       GlobalDeleteAtom(AppTopic)
  109.   end else
  110.   begin
  111.     DDEStatus := LoWord(Msg.LParam);
  112.     if (DDEStatus and dde_Ack) <> dde_Ack then
  113.       MessageBox(HWindow,
  114.         'Command rejected by Program Manager', 'Error', mb_Ok);
  115.     HMem := HiWord(Msg.LParam);
  116.     if HMem <> 0 then
  117.       GlobalFree(HMem)
  118.   end;
  119. end;
  120.  
  121. {- Respond to wm_DDE_Terminate message }
  122. procedure PMRunWindow.WMDDETerminate(var Msg: TMessage);
  123. begin
  124.   LinkEstablished := false
  125. end;
  126.  
  127. {- Link to PM if not linked. Return true if linked }
  128. function PMRunWindow.Linked: Boolean;
  129. var
  130.   AppAtom, AppTopic: TAtom;
  131. begin
  132.   if not LinkEstablished then
  133.   begin
  134.     AppAtom := GlobalAddAtom(serverName);
  135.     AppTopic := GlobalAddAtom(serverTopic);
  136.     SendMessage(Word(-1), wm_DDE_Initiate, HWindow,
  137.       MakeLong(AppAtom, AppTopic));
  138.     GlobalDeleteAtom(AppAtom);
  139.     GlobalDeleteAtom(AppTopic)
  140.   end;
  141.   Linked := LinkEstablished
  142. end;
  143.  
  144. {- Send command to Program Manager }
  145. procedure PMRunWindow.SendPMCommand(P: PChar);
  146. var
  147.   HCmd: THandle;  { Handle to memory block }
  148.   PCmd: PChar;    { Pointer to same block as a string }
  149. begin
  150.   if Linked then
  151.   begin
  152.     HCmd := GlobalAlloc(gmem_Moveable or gmem_DDEShare,
  153.       StrLen(P) + 1);
  154.     if HCmd <> 0 then
  155.     begin
  156.       PCmd := GlobalLock(HCmd);
  157.       if PCmd = nil then
  158.         GlobalFree(HCmd)
  159.       else begin
  160.         StrCopy(PCmd, P);
  161.         GlobalUnlock(HCmd);
  162.         if not PostMessage(HWndPM, wm_DDE_Execute, HWindow,
  163.           MakeLong(0, HCmd)) then
  164.           GlobalFree(HCmd)
  165.       end
  166.     end
  167.   end else
  168.     MessageBox(HWindow, 'Link to Program Manager failed',
  169.       'Note', mb_Ok)
  170. end;
  171.  
  172. {- Execute Program Manager command }
  173. procedure PMRunWindow.Execute(Prompt, Command: PChar);
  174. var
  175.   P: PChar;       { Pointer to locally allocated string }
  176.   Len: Integer;   { Length of full command string }
  177.   Buffer: array[0 .. maxBufLen] of Char;
  178. begin
  179.   if GetCommand(Prompt, Buffer) then
  180.   begin
  181.     Len := 1 {null} + 2 {brackets} + StrLen(Command) + 2 {parens} +
  182.       StrLen(Buffer);
  183.     GetMem(P, Len);
  184.     if P = nil then
  185.       MessageBox(HWindow, 'Out of memory',
  186.         'Error', mb_Ok)
  187.     else begin
  188.       StrCopy(P, '[');        { Put command into correct format }
  189.       StrCat(P, Command);
  190.       StrCat(P, '(');
  191.       StrCat(P, Buffer);
  192.       StrCat(P, ')]');
  193.       SendPMCommand(P);       { Send command to PM }
  194.       FreeMem(P, Len)
  195.     end
  196.   end
  197. end;
  198.  
  199. {- Create new program manager group window }
  200. procedure PMRunWindow.CMCreateGroup(var Msg: TMessage);
  201. begin
  202.   Execute('GroupName[,GroupPath]', 'CreateGroup')
  203. end;
  204.  
  205. {- Add program item to a group window }
  206. procedure PMRunWindow.CMAddItem(var Msg: TMessage);
  207. begin
  208.   Execute('CmdLine[,Name[,IconPath[,IconIndex[,X,Y]]]]', 'AddItem')
  209. end;
  210.  
  211. {- Show group window if it exists }
  212. procedure PMRunWindow.CMShowGroup(var Msg: TMessage);
  213. begin
  214.   Execute('GroupName,Command', 'ShowGroup')
  215. end;
  216.  
  217. {- Exit Program Manager, and subsequently, Windows }
  218. procedure PMRunWindow.CMExitWindows(var Msg: TMessage);
  219. var
  220.   P: PChar;
  221. begin
  222.   SendPMCommand('[ExitProgman(TRUE)]')  { ??? }
  223. end;
  224.  
  225. {- Exit this application only }
  226. procedure PMRunWindow.CMQuit(var Msg: TMessage);
  227. begin
  228.   CloseWindow
  229. end;
  230.  
  231. var
  232.  
  233.   PMRunApp: PMRunApplication;
  234.  
  235. begin
  236.   PMRunApp.Init('PMRunApp');
  237.   PMRunApp.Run;
  238.   PMRunApp.Done
  239. end.
  240.  
  241.  
  242. {--------------------------------------------------------------
  243.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  244.   Revision 1.00    Date: 5/28/1991
  245. ---------------------------------------------------------------}
  246.